home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / src / tclEnv.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-01  |  14.7 KB  |  578 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCL_ENV
  3. #endif
  4.  
  5. /* 
  6.  * tclEnv.c --
  7.  *
  8.  *    Tcl support for environment variables, including a setenv
  9.  *    procedure.
  10.  *
  11.  * Copyright (c) 1991-1993 The Regents of the University of California.
  12.  * All rights reserved.
  13.  *
  14.  * Permission is hereby granted, without written agreement and without
  15.  * license or royalty fees, to use, copy, modify, and distribute this
  16.  * software and its documentation for any purpose, provided that the
  17.  * above copyright notice and the following two paragraphs appear in
  18.  * all copies of this software.
  19.  * 
  20.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  21.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  22.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  23.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  24.  *
  25.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  26.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  27.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  28.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  29.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  30.  */
  31.  
  32. #ifndef lint
  33. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclEnv.c,v 1.16 93/07/19 10:05:42 ouster Exp $ SPRITE (Berkeley)";
  34. #endif /* not lint */
  35.  
  36. /*
  37.  * The putenv and setenv definitions below cause any system prototypes for
  38.  * those procedures to be ignored so that there won't be a clash when the
  39.  * versions in this file are compiled.
  40.  */
  41.  
  42. #define putenv ignore_putenv
  43. #define setenv ignore_setenv
  44. #include "tclInt.h"
  45. #include "tclUnix.h"
  46. #undef putenv
  47. #undef setenv
  48.  
  49. /*
  50.  * The structure below is used to keep track of all of the interpereters
  51.  * for which we're managing the "env" array.  It's needed so that they
  52.  * can all be updated whenever an environment variable is changed
  53.  * anywhere.
  54.  */
  55.  
  56. typedef struct EnvInterp {
  57.     Tcl_Interp *interp;        /* Interpreter for which we're managing
  58.                  * the env array. */
  59.     struct EnvInterp *nextPtr;    /* Next in list of all such interpreters,
  60.                  * or zero. */
  61. } EnvInterp;
  62.  
  63. static EnvInterp *firstInterpPtr;
  64.                 /* First in list of all managed interpreters,
  65.                  * or NULL if none. */
  66.  
  67. static int environSize = 0;    /* Non-zero means that the all of the
  68.                  * environ-related information is malloc-ed
  69.                  * and the environ array itself has this
  70.                  * many total entries allocated to it (not
  71.                  * all may be in use at once).  Zero means
  72.                  * that the environment array is in its
  73.                  * original static state. */
  74.  
  75. /*
  76.  * Declarations for local procedures defined in this file:
  77.  */
  78.  
  79. static void        EnvInit _ANSI_ARGS_((void));
  80. static char *        EnvTraceProc _ANSI_ARGS_((ClientData clientData,
  81.                 Tcl_Interp *interp, char *name1, char *name2,
  82.                 int flags));
  83. static int        FindVariable _ANSI_ARGS_((CONST char *name,
  84.                 int *lengthPtr));
  85. void            TclSetEnv _ANSI_ARGS_((CONST char *name,
  86.                 CONST char *value));
  87. void            TclUnsetEnv _ANSI_ARGS_((CONST char *name));
  88.  
  89. /*
  90.  *----------------------------------------------------------------------
  91.  *
  92.  * TclSetupEnv --
  93.  *
  94.  *    This procedure is invoked for an interpreter to make environment
  95.  *    variables accessible from that interpreter via the "env"
  96.  *    associative array.
  97.  *
  98.  * Results:
  99.  *    None.
  100.  *
  101.  * Side effects:
  102.  *    The interpreter is added to a list of interpreters managed
  103.  *    by us, so that its view of envariables can be kept consistent
  104.  *    with the view in other interpreters.  If this is the first
  105.  *    call to Tcl_SetupEnv, then additional initialization happens,
  106.  *    such as copying the environment to dynamically-allocated space
  107.  *    for ease of management.
  108.  *
  109.  *----------------------------------------------------------------------
  110.  */
  111.  
  112. void
  113. TclSetupEnv(interp)
  114.     Tcl_Interp *interp;        /* Interpreter whose "env" array is to be
  115.                  * managed. */
  116. {
  117.     EnvInterp *eiPtr;
  118.     int i;
  119.  
  120.     /*
  121.      * First, initialize our environment-related information, if
  122.      * necessary.
  123.      */
  124.  
  125.     if (environSize == 0) {
  126.     EnvInit();
  127.     }
  128.  
  129.     /*
  130.      * Next, add the interpreter to the list of those that we manage.
  131.      */
  132.  
  133.     eiPtr = (EnvInterp *) ckalloc(sizeof(EnvInterp));
  134.     eiPtr->interp = interp;
  135.     eiPtr->nextPtr = firstInterpPtr;
  136.     firstInterpPtr = eiPtr;
  137.  
  138.     /*
  139.      * Store the environment variable values into the interpreter's
  140.      * "env" array, and arrange for us to be notified on future
  141.      * writes and unsets to that array.
  142.      */
  143.  
  144.     (void) Tcl_UnsetVar2(interp, "env", (char *) NULL, TCL_GLOBAL_ONLY);
  145.     for (i = 0; ; i++) {
  146.     char *p, *p2;
  147.  
  148.     p = environ[i];
  149.     if (p == NULL) {
  150.         break;
  151.     }
  152.     for (p2 = p; *p2 != '='; p2++) {
  153.         /* Empty loop body. */
  154.     }
  155.     *p2 = 0;
  156.     (void) Tcl_SetVar2(interp, "env", p, p2+1, TCL_GLOBAL_ONLY);
  157.     *p2 = '=';
  158.     }
  159.     Tcl_TraceVar2(interp, "env", (char *) NULL,
  160.         TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS,
  161.         EnvTraceProc, (ClientData) NULL);
  162. }
  163.  
  164. /*
  165.  *----------------------------------------------------------------------
  166.  *
  167.  * FindVariable --
  168.  *
  169.  *    Locate the entry in environ for a given name.
  170.  *
  171.  * Results:
  172.  *    The return value is the index in environ of an entry with the
  173.  *    name "name", or -1 if there is no such entry.   The integer at
  174.  *    *lengthPtr is filled in with the length of name (if a matching
  175.  *    entry is found) or the length of the environ array (if no matching
  176.  *    entry is found).
  177.  *
  178.  * Side effects:
  179.  *    None.
  180.  *
  181.  *----------------------------------------------------------------------
  182.  */
  183.  
  184. static int
  185. FindVariable(name, lengthPtr)
  186.     CONST char *name;        /* Name of desired environment variable. */
  187.     int *lengthPtr;        /* Used to return length of name (for
  188.                  * successful searches) or number of non-NULL
  189.                  * entries in environ (for unsuccessful
  190.                  * searches). */
  191. {
  192.     int i;
  193.     CONST register char *p1, *p2;
  194.  
  195.     for (i = 0, p1 = environ[i]; p1 != NULL; i++, p1 = environ[i]) {
  196.     for (p2 = name; *p2 == *p1; p1++, p2++) {
  197.         /* NULL loop body. */
  198.     }
  199.     if ((*p1 == '=') && (*p2 == '\0')) {
  200.         *lengthPtr = p2-name;
  201.         return i;
  202.     }
  203.     }
  204.     *lengthPtr = i;
  205.     return -1;
  206. }
  207.  
  208. /*
  209.  *----------------------------------------------------------------------
  210.  *
  211.  * TclSetEnv --
  212.  *
  213.  *    Set an environment variable, replacing an existing value
  214.  *    or creating a new variable if there doesn't exist a variable
  215.  *    by the given name.  This procedure is intended to be a
  216.  *    stand-in for the  UNIX "setenv" procedure so that applications
  217.  *    using that procedure will interface properly to Tcl.  To make
  218.  *    it a stand-in, the Makefile must define "TclSetEnv" to "setenv".
  219.  *
  220.  * Results:
  221.  *    None.
  222.  *
  223.  * Side effects:
  224.  *    The environ array gets updated, as do all of the interpreters
  225.  *    that we manage.
  226.  *
  227.  *----------------------------------------------------------------------
  228.  */
  229.  
  230. void
  231. TclSetEnv(name, value)
  232.     CONST char *name;        /* Name of variable whose value is to be
  233.                  * set. */
  234.     CONST char *value;        /* New value for variable. */
  235. {
  236.     int index, length, nameLength;
  237.     char *p;
  238.     EnvInterp *eiPtr;
  239.  
  240.     if (environSize == 0) {
  241.     EnvInit();
  242.     }
  243.  
  244.     /*
  245.      * Figure out where the entry is going to go.  If the name doesn't
  246.      * already exist, enlarge the array if necessary to make room.  If
  247.      * the name exists, free its old entry.
  248.      */
  249.  
  250.     index = FindVariable(name, &length);
  251.     if (index == -1) {
  252.     if ((length+2) > environSize) {
  253.         char **newEnviron;
  254.  
  255.         newEnviron = (char **) ckalloc((unsigned)
  256.             ((length+5) * sizeof(char *)));
  257.         memcpy((VOID *) newEnviron, (VOID *) environ,
  258.             length*sizeof(char *));
  259.         ckfree((char *) environ);
  260.         environ = newEnviron;
  261.         environSize = length+5;
  262.     }
  263.     index = length;
  264.     environ[index+1] = NULL;
  265.     nameLength = strlen(name);
  266.     } else {
  267.     /*
  268.      * Compare the new value to the existing value.  If they're
  269.      * the same then quit immediately (e.g. don't rewrite the
  270.      * value or propagate it to other interpeters).  Otherwise,
  271.      * when there are N interpreters there will be N! propagations
  272.      * of the same value among the interpreters.
  273.      */
  274.  
  275.     if (strcmp(value, environ[index]+length+1) == 0) {
  276.         return;
  277.     }
  278.     ckfree(environ[index]);
  279.     nameLength = length;
  280.     }
  281.  
  282.     /*
  283.      * Create a new entry and enter it into the table.
  284.      */
  285.  
  286.     p = (char *) ckalloc((unsigned) (nameLength + strlen(value) + 2));
  287.     environ[index] = p;
  288.     strcpy(p, name);
  289.     p += nameLength;
  290.     *p = '=';
  291.     strcpy(p+1, value);
  292.  
  293. #ifdef macintosh
  294.     check_environment_set_of_globals(name, value);
  295. #endif
  296.  
  297.     /*
  298.      * Update all of the interpreters.
  299.      */
  300.  
  301.     for (eiPtr= firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
  302.     (void) Tcl_SetVar2(eiPtr->interp, "env", (char *) name,
  303.         p+1, TCL_GLOBAL_ONLY);
  304.     }
  305. }
  306.  
  307. /*
  308.  *----------------------------------------------------------------------
  309.  *
  310.  * Tcl_PutEnv --
  311.  *
  312.  *    Set an environment variable.  Similar to setenv except that
  313.  *    the information is passed in a single string of the form
  314.  *    NAME=value, rather than as separate name strings.  This procedure
  315.  *    is intended to be a stand-in for the  UNIX "putenv" procedure
  316.  *    so that applications using that procedure will interface
  317.  *    properly to Tcl.  To make it a stand-in, the Makefile will
  318.  *    define "Tcl_PutEnv" to "putenv".
  319.  *
  320.  * Results:
  321.  *    None.
  322.  *
  323.  * Side effects:
  324.  *    The environ array gets updated, as do all of the interpreters
  325.  *    that we manage.
  326.  *
  327.  *----------------------------------------------------------------------
  328.  */
  329.  
  330. int
  331. Tcl_PutEnv(string)
  332.     CONST char *string;        /* Info about environment variable in the
  333.                  * form NAME=value. */
  334. {
  335.     int nameLength;
  336.     char *name, *value;
  337.  
  338.     if (string == NULL) {
  339.     return 0;
  340.     }
  341.  
  342.     /*
  343.      * Separate the string into name and value parts, then call
  344.      * TclSetEnv to do all of the real work.
  345.      */
  346.  
  347.     value = strchr(string, '=');
  348.     if (value == NULL) {
  349.     return 0;
  350.     }
  351.     nameLength = value - string;
  352.     if (nameLength == 0) {
  353.     return 0;
  354.     }
  355.     name = ckalloc((unsigned) nameLength+1);
  356.     memcpy(name, string, nameLength);
  357.     name[nameLength] = 0;
  358.     TclSetEnv(name, value+1);
  359.     ckfree(name);
  360.     return 0;
  361. }
  362. /*
  363.  *----------------------------------------------------------------------
  364.  *
  365.  * tcl_getenv --
  366.  *
  367.  *
  368.  * Results:
  369.  *    None.
  370.  *
  371.  * Side effects:
  372.  *
  373.  *----------------------------------------------------------------------
  374.  */
  375.  
  376. char *
  377. tcl_getenv(name)
  378. char        *name;            /* Name of variable to remove. */
  379. {
  380. int        index, dummy;
  381. char    *ptr;
  382.  
  383.     if (environSize == 0)
  384.         EnvInit();
  385.  
  386.     index = FindVariable(name, &dummy);
  387.     
  388.     if (index == -1)
  389.         return NULL;
  390.     else
  391.         {
  392.         ptr = strchr(environ[index], '=');
  393.         if (ptr != NULL)
  394.             return ptr + 1;
  395.         else
  396.             return "";
  397.         }
  398.     }
  399.  
  400. /*
  401.  *----------------------------------------------------------------------
  402.  *
  403.  * TclUnsetEnv --
  404.  *
  405.  *    Remove an environment variable, updating the "env" arrays
  406.  *    in all interpreters managed by us.  This function is intended
  407.  *    to replace the UNIX "unsetenv" function (but to do this the
  408.  *    Makefile must be modified to redefine "TclUnsetEnv" to
  409.  *    "unsetenv".
  410.  *
  411.  * Results:
  412.  *    None.
  413.  *
  414.  * Side effects:
  415.  *    Interpreters are updated, as is environ.
  416.  *
  417.  *----------------------------------------------------------------------
  418.  */
  419.  
  420. void
  421. TclUnsetEnv(name)
  422.     CONST char *name;            /* Name of variable to remove. */
  423. {
  424.     int index, dummy;
  425.     char **envPtr;
  426.     EnvInterp *eiPtr;
  427.  
  428.     if (environSize == 0) {
  429.     EnvInit();
  430.     }
  431.  
  432.     /*
  433.      * Update the environ array.
  434.      */
  435.  
  436.     index = FindVariable(name, &dummy);
  437.     if (index == -1) {
  438.     return;
  439.     }
  440.     ckfree(environ[index]);
  441.     for (envPtr = environ+index+1; ; envPtr++) {
  442.     envPtr[-1] = *envPtr;
  443.     if (*envPtr == NULL) {
  444.         break;
  445.        }
  446.     }
  447.  
  448.     /*
  449.      * Update all of the interpreters.
  450.      */
  451.  
  452.     for (eiPtr = firstInterpPtr; eiPtr != NULL; eiPtr = eiPtr->nextPtr) {
  453.     (void) Tcl_UnsetVar2(eiPtr->interp, "env", (char *) name,
  454.         TCL_GLOBAL_ONLY);
  455.     }
  456. }
  457.  
  458. /*
  459.  *----------------------------------------------------------------------
  460.  *
  461.  * EnvTraceProc --
  462.  *
  463.  *    This procedure is invoked whenever an environment variable
  464.  *    is modified or deleted.  It propagates the change to the
  465.  *    "environ" array and to any other interpreters for whom
  466.  *    we're managing an "env" array.
  467.  *
  468.  * Results:
  469.  *    Always returns NULL to indicate success.
  470.  *
  471.  * Side effects:
  472.  *    Environment variable changes get propagated.  If the whole
  473.  *    "env" array is deleted, then we stop managing things for
  474.  *    this interpreter (usually this happens because the whole
  475.  *    interpreter is being deleted).
  476.  *
  477.  *----------------------------------------------------------------------
  478.  */
  479.  
  480.     /* ARGSUSED */
  481. static char *
  482. EnvTraceProc(clientData, interp, name1, name2, flags)
  483.     ClientData clientData;    /* Not used. */
  484.     Tcl_Interp *interp;        /* Interpreter whose "env" variable is
  485.                  * being modified. */
  486.     char *name1;        /* Better be "env". */
  487.     char *name2;        /* Name of variable being modified, or
  488.                  * NULL if whole array is being deleted. */
  489.     int flags;            /* Indicates what's happening. */
  490. {
  491.     /*
  492.      * First see if the whole "env" variable is being deleted.  If
  493.      * so, just forget about this interpreter.
  494.      */
  495.  
  496.     if (name2 == NULL) {
  497.     register EnvInterp *eiPtr, *prevPtr;
  498.  
  499.     if ((flags & (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED))
  500.         != (TCL_TRACE_UNSETS|TCL_TRACE_DESTROYED)) {
  501.         panic("EnvTraceProc called with confusing arguments");
  502.     }
  503.     eiPtr = firstInterpPtr;
  504.     if (eiPtr->interp == interp) {
  505.         firstInterpPtr = eiPtr->nextPtr;
  506.     } else {
  507.         for (prevPtr = eiPtr, eiPtr = eiPtr->nextPtr; ;
  508.             prevPtr = eiPtr, eiPtr = eiPtr->nextPtr) {
  509.         if (eiPtr == NULL) {
  510.             panic("EnvTraceProc couldn't find interpreter");
  511.         }
  512.         if (eiPtr->interp == interp) {
  513.             prevPtr->nextPtr = eiPtr->nextPtr;
  514.             break;
  515.         }
  516.         }
  517.     }
  518.     ckfree((char *) eiPtr);
  519.     return NULL;
  520.     }
  521.  
  522.     /*
  523.      * If a value is being set, call TclSetEnv to do all of the work.
  524.      */
  525.  
  526.     if (flags & TCL_TRACE_WRITES) {
  527.     TclSetEnv(name2, Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY));
  528.     }
  529.  
  530.     if (flags & TCL_TRACE_UNSETS) {
  531.     TclUnsetEnv(name2);
  532.     }
  533.     return NULL;
  534. }
  535.  
  536. /*
  537.  *----------------------------------------------------------------------
  538.  *
  539.  * EnvInit --
  540.  *
  541.  *    This procedure is called to initialize our management
  542.  *    of the environ array.
  543.  *
  544.  * Results:
  545.  *    None.
  546.  *
  547.  * Side effects:
  548.  *    Environ gets copied to malloc-ed storage, so that in
  549.  *    the future we don't have to worry about which entries
  550.  *    are malloc-ed and which are static.
  551.  *
  552.  *----------------------------------------------------------------------
  553.  */
  554.  
  555. static void
  556. EnvInit()
  557. {
  558.     char **newEnviron;
  559.     int i, length;
  560.  
  561.     if (environSize != 0) {
  562.     return;
  563.     }
  564.     for (length = 0; environ[length] != NULL; length++) {
  565.     /* Empty loop body. */
  566.     }
  567.     environSize = length+5;
  568.     newEnviron = (char **) ckalloc((unsigned)
  569.         (environSize * sizeof(char *)));
  570.     for (i = 0; i < length; i++) {
  571.     newEnviron[i] = (char *) ckalloc((unsigned) (strlen(environ[i]) + 1));
  572.     strcpy(newEnviron[i], environ[i]);
  573.     }
  574.     newEnviron[length] = NULL;
  575.     environ = newEnviron;
  576. }
  577.  
  578.